library(tis)
library(rlist)
library(frb)
library(fame)
library(readxl)
library(tidyverse)
if ("policyPlot" %in% (.packages())) {
  detach("package:policyPlot", unload=TRUE)
}
suppressWarnings(library(policyPlot, warn.conflicts = FALSE))

read_csv_nomsg <- function(...) {
  df <- suppressMessages(read_csv(...))
  return(df)
}

### UNCOMMENT THIS 
#source(paste0("[your home directory]/Gini_code/dfa_splits.R"))

source("[your public Financial Accounts data")

# Default quarter for functions is the current Z1 quarter being produced (if database is fofnet) 
# or the most recently published quarter (if database is fof)

if(!exists("b101h_db")) {
  b101h_db <- "fof"
} 

date_series <- fame2df("PC073164013.Q", b101h_db)
cur_qtr <- as.yearqtr(max(date_series$date))
cur_qtr <- format(cur_qtr, format = "%Yq%q")

scf_qtrs <- as.yearqtr(seq.Date(from = as.Date("1989-09-30"), to = as.Date("2019-09-30"), by = "3 year"))

dfa_file_names <- function(item = "", extension = ".csv", group = "networth", method = "fernandez", agg_level = "default", scf_ignore = NULL, filetag = NULL) {
  
  name_vec <- character()
  name_vec[1] <- "dfa"
  name_vec[2] <- group
  index <- 3
  
  if (method != "fernandez") {
    name_vec[index] <- method
    index <- index + 1
  }
  
  if (agg_level != "default") {
    name_vec[index] <- agg_level
    index <- index + 1 
  }
  
  if (!is.null(scf_ignore)) {
    name_vec[index] <- paste0("skip_", scf_ignore) 
    index <- index + 1
  }
  
  if (item != "") {
    name_vec[index] <- item
    index <- index + 1
  }
  
  if (!is.null(filetag)) {
    name_vec[index] <- filetag
  }
  
  file_name <- paste(name_vec, collapse = "_")
  file_name <- paste0(file_name, extension)
  
  return(file_name)
}

read_dfa <- function(.item, .group = "networth", .agg_level = "default", .method = "fernandez", .scf_ignore = NULL, .filetag = NULL, path = getwd()) {
  
  if (agg_level == "high"){
    groupnames <- c("Top1","Next9","Next40","Bottom50")
  } else if (agg_level == "low"){
    groupnames <- c("Top1","pct95to99","pct90to95","pct80to90","pct70to80","pct60to70","pct50to60","pct40to50","pct30to40","pct20to30","pct10to20","Bottom10")
  }
  #groupnames <- dfa_splits(group = .group, agg_level = .agg_level)[["groupnames"]]
  
  data <- read_csv_nomsg(file.path(path, dfa_file_names(item = .item, group = .group,  agg_level = .agg_level, method = .method, scf_ignore = .scf_ignore, filetag = .filetag)), 
                   col_types = cols(.default = "d", date = "c", cat = col_factor(levels = groupnames)))
  data$date <- as.yearqtr(data$date)
  
  return(data)
}

scale2one <- function(vec) {return(vec/max(na.omit(vec)))}
normalize <- function(vec) {return(vec/mean(na.omit(vec)))}

noneg <- function(vec) {vec[vec<0] <- 0; return(vec)}

## This function puts in zeroes in the y vector for non-SCF years

skipk <- function(list1, k) {
  list2 = c()
  for(i in 1:length(list1)) {
    list2 <- append(list2,list1[i])
    for (j in 1:(k-1)) {
      list2 <- append(list2,0)
    }
  }
  # ammended 2019q3: to account for lag in getting new SCF data
  if (forecast_last_scf == TRUE) {
    list2 <- c(list2, rep(0, num_forecast))
  }
  return(list2)
}



## Write a function that brings in SCF output
scf_balance_sheet <- function(excel, hh = FALSE, income = FALSE){
  
  sheet_names <- excel_sheets(excel)
  sheet_names <- sapply(strsplit(sheet_names," "), `[`, 1)
  
  ## Read in the excel files. The format must be consistent (check DFA_reconciliation). 4 sheets: Nonfinancial Assets, Financial Assets, Other Assets, and Liabilites. 
  ###!!! Need more extensive documentation on how the SCF inputs need to be formated 
  non_fin_sheet <- read_excel(excel, sheet = which(sheet_names == "nonfin"), trim_ws = TRUE, col_types = "numeric") %>%
    drop_na(2)
  fin_sheet <- read_excel(excel, sheet = which(sheet_names == "fin"), trim_ws = TRUE, col_types = "numeric") %>%
    drop_na(2)
  other_sheet <- read_excel(excel, sheet = which(sheet_names == "othassets"), trim_ws = TRUE, col_types = "numeric") %>%
    drop_na(2)
  liabilities_sheet <- read_excel(excel, sheet = which(sheet_names == "liab"), trim_ws = TRUE, col_types = "numeric") %>%
    drop_na(2)
  
  if (hh == TRUE) {
    aux_sheet <- read_excel(excel, sheet = which(sheet_names == "households"), trim_ws = TRUE, col_types = c("numeric", "numeric", "numeric", "skip", "skip", "skip", "skip"), .name_repair = "minimal") %>%
      drop_na(2)
  }
  
  balance_sheet <- list()
  
  balance_sheet[["real_estate"]] <- non_fin_sheet$scf_fa_real_estate
  balance_sheet[["con_durables"]] <- non_fin_sheet$scf_fa_consumer_durables
  
  balance_sheet[["check_curr"]] <- fin_sheet$scf_fa_check_fgn_dep_curr
  balance_sheet[["time_dep"]] <- fin_sheet$scf_fa_time_dep
  balance_sheet[["mmfs"]] <- fin_sheet$scf_fa_mmmf_shares
  
  balance_sheet[["us_gov_muni"]] <- fin_sheet$scf_fa_gov_muni_bnds
  balance_sheet[["corp_for_bonds"]] <- fin_sheet$scf_fa_corp_for_bnds
  
  balance_sheet[["oth_loans"]] <- other_sheet$scf_fa_othln_owed
  balance_sheet[["morts_owed"]] <- other_sheet$scf_fa_mort_owed
  
  balance_sheet[["corp_equ_mfs"]] <- other_sheet$scf_fa_corpeq_mut
  balance_sheet[["life_ins"]] <- other_sheet$scf_fa_life_ins
  balance_sheet[["pension"]] <- other_sheet$scf_fa_pension
  balance_sheet[["non_corp_eq"]] <- other_sheet$scf_fa_equity_non_corp
  balance_sheet[["misc_assets"]] <- other_sheet$scf_fa_misc_assets
  
  balance_sheet[["morts"]] <- liabilities_sheet$scf_fa_mort_debt
  balance_sheet[["cons_cred"]] <- liabilities_sheet$scf_fa_consumer_credit
  balance_sheet[["dep_loans"]] <- liabilities_sheet$scf_fa_dep_inst_loans
  balance_sheet[["oth_loans_adv"]] <- liabilities_sheet$scf_fa_oth_loans
  
  balance_sheet[["unpaid_life_ins"]] <- liabilities_sheet$scf_fa_life_ins_unpaid
  
  if (hh == TRUE) {
    balance_sheet[["hhcount"]] <- aux_sheet$hhcount
  }
  
  if (income == TRUE) {
    
    # use whichever income data are available -- varies by split
    
    if ("inc" %in% sheet_names) {
      
      inc_sheet <- read_excel(excel, paste0(sheet = "inc by ", tag), col_types = "numeric") %>%
        drop_na()
      balance_sheet[["inc"]] <- inc_sheet[["income"]]
    }
    
    if ("nipainc" %in% sheet_names) {
      nipainc_sheet <- read_excel(excel, sheet = paste0("nipainc by ", tag), col_types = "numeric") %>%
        drop_na()
      balance_sheet[["nipainc"]] <- nipainc_sheet[["nipa_equiv_income"]]
    }
    
    if ("norminc" %in% sheet_names) {
      norminc_sheet <- read_excel(excel, sheet = paste0("norminc by ", tag), col_types = "numeric") %>%
        drop_na()
      balance_sheet[["norminc"]] <- norminc_sheet[["norminc"]]
    }
  }
  
  balance_sheet <- bind_cols(balance_sheet)
  
  ## Now construct the balance sheet in the format of the B101h table. The series labels are done manually to look as much like the fame tables as possible.
  
  ids <- non_fin_sheet[,1:2] %>%
    mutate(date = as.yearqtr(year + .5)) %>%
    setNames(c("year", "cat", "date")) %>%
    select(date, cat)

  
  scf_data <- bind_cols(ids, balance_sheet)
  
  return(scf_data)
}

neg_to_zero <- function(x) ifelse(x < 0, 0, x)

# puts fame data into a dataframe 
# goes from 1989 until today
# pulls from fame, builds data frame, makes daily series quarterly 

f2q.end <- function(series,database) {
  today <- as.Date(as.yearqtr(lastqtr) + .25)
  today <- as.numeric(format(today, c("%Y%m%d")))
  data <- fame2df(series,database) # get series from fame 
  data <- na.omit(data) # remove NA values
  data$date <- as.Date(data$date)
  freq <- frequency(getfame(series,database)[[1]])
  dates <- sort(c(seq(19890930,today,by=10000),seq(19891231,today,by=10000),seq(19900331,today,by=10000),seq(19900630,today,by=10000)))
  #dates <- sort(c(seq(19890930,today,by=10000)))
  df <- data.frame(date = as.Date(as.character(dates), format = "%Y%m%d"))
  df$value <- NA
  
  for (index in 1:length(df$date)) {
    if (length(which(data$date == df$date[index])) > 0) {
      index2 <- which(data$date == df$date[index])
      df$value[index] = data[[2]][index2]
    } else {
      index2 <- max(which(data$date < df$date[index]))
      df$value[index] = data[[2]][index2]
    }
  }
  return(df)
}

kroot <- function(x) {(sign(x)^k)*(abs(x))^(1/k)} # This takes the kth root

dfa_getfame <- function(series, database) {
  df <- policyPlot::fame2df(series, database) %>%
    drop_na() %>%
    mutate(date = as.yearqtr(date)) %>%
    mutate_if(is.array, as.numeric)%>%
    dplyr::filter(date >= as.yearqtr("1989q3"), date <= as.yearqtr(lastqtr)) %>% # _filter out observations before the start date (1989q3)
    group_by(date) %>%
    summarise_all(data.table::last) # convert to quarterly series by choosing last value in each quarter
  
  return(df)
}

